home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_FileRunner.idb / usr / freeware / lib / FileRunner2.5 / ftp.tcl.z / ftp.tcl
Encoding:
Text File  |  1999-01-26  |  24.2 KB  |  854 lines
  1.  
  2.  
  3. # --------- API commands 
  4. proc FTP_OpenSession { ftpI host_and_port user password realhost} {
  5.   global ftp
  6.  
  7.   set ftp($ftpI,realhost) $realhost
  8.   set ftp($ftpI,user) $user
  9.   set ftp($ftpI,password) $password
  10.   set ftp($ftpI,state) initial
  11.   set ftp($ftpI,type) unknown
  12.   set ftp($ftpI,ctl_fd) 0
  13.   set ftp($ftpI,server_fd) 0
  14.   set ftp($ftpI,debug) 0
  15.   set ftp($ftpI,local_ip) ""
  16.   set ftp($ftpI,pwd) ""
  17.   set ftp($ftpI,new_wd) ""
  18.   set ftp($ftpI,ctl_mess) ""
  19.   set ftp($ftpI,ctl_cmd) ""
  20.   set ftp($ftpI,resume) 0
  21.   set r [regexp {([^:]+)(:([0-9]+))?} $host_and_port match ftp($ftpI,host) dummy ftp($ftpI,port)]
  22.   if {!$r} {
  23.     FTP_Error $ftpI "Malformed FTP URL $host_and_port. Format: site:port ex: ftp.foo.bar:21"
  24.   }
  25.   if {$ftp($ftpI,port) == ""} {
  26.     set ftp($ftpI,port) 21
  27.   }
  28.  
  29.   FTP_CtlAutomata $ftpI
  30.   #FTP_CD $ftpI /
  31. }
  32.  
  33. proc FTP_MakeSureLinkIsUp { ftpI } {
  34.   # Can only be called after FTP_SetHost has been called 
  35.   global ftp
  36.   if { $ftp($ftpI,state) == "initial" } {
  37.     Log "Reopening FTP link to $ftp($ftpI,realhost)"
  38.     FTP_CtlAutomata $ftpI
  39.     #FTP_CD $ftpI /
  40.   }
  41. }
  42.  
  43. proc FTP_TrimDir { dir } {
  44.   while { [string range $dir 0 1] == "//" } {
  45.     set dir [string range $dir 1 end]
  46.   }
  47.   set dir [string trimright $dir /]
  48.   if { $dir == "" } { set dir / }
  49.   if { [string index $dir 0] == "/" } {
  50.     while { 1 } {
  51.       set len [string length $dir]
  52.       if { [string range $dir [expr $len - 3] end] == "/.." } {
  53.         set dir [file dirname [file dirname $dir]]
  54.       } else {
  55.         break
  56.       }
  57.     }
  58.   }
  59.   return $dir
  60. }
  61.  
  62. proc FTP_CD { ftpI new_wd } {
  63.   global ftp
  64.   if {[string index $new_wd 0] != "/"} {
  65.     FTP_Error $ftpI "Internal error: FTP_CD can only be called with an absolute path."
  66.   }
  67.   FTP_MakeSureLinkIsUp $ftpI
  68.   set new_wd [FTP_TrimDir $new_wd]
  69.   if { $new_wd == $ftp($ftpI,pwd) } {
  70.     return ""
  71.   }
  72.   set ftp($ftpI,new_wd) $new_wd
  73.   set ftp($ftpI,state) docd
  74.   FTP_CtlAutomata $ftpI
  75. }
  76.  
  77. proc FTP_Rename { ftpI oldname newname } {
  78.   global ftp
  79.   FTP_MakeSureLinkIsUp $ftpI
  80.   set ftp($ftpI,rename,oldname) $oldname
  81.   set ftp($ftpI,rename,newname) $newname
  82.   set ftp($ftpI,state) rename
  83.   FTP_InvalidateCache
  84.   FTP_CtlAutomata $ftpI
  85. }
  86.  
  87. proc FTP_Delete { ftpI filename } {
  88.   global ftp
  89.   FTP_MakeSureLinkIsUp $ftpI
  90.   set ftp($ftpI,delete,filename) $filename
  91.   set ftp($ftpI,state) delete
  92.   FTP_InvalidateCache
  93.   FTP_CtlAutomata $ftpI
  94. }
  95.  
  96. proc FTP_MkDir { ftpI dir } {
  97.   global ftp
  98.   FTP_MakeSureLinkIsUp $ftpI
  99.   set ftp($ftpI,mkdir,dir) $dir
  100.   set ftp($ftpI,state) mkdir
  101.   FTP_InvalidateCache
  102.   FTP_CtlAutomata $ftpI
  103. }
  104.  
  105. proc FTP_RmDir { ftpI dir } {
  106.   global ftp
  107.   FTP_MakeSureLinkIsUp $ftpI
  108.   set ftp($ftpI,rmdir,dir) $dir
  109.   set ftp($ftpI,state) rmdir
  110.   FTP_InvalidateCache
  111.   FTP_CtlAutomata $ftpI
  112. }
  113.  
  114. proc FTP_IsDir { ftpI new_wd } {
  115.   global ftp
  116.   FTP_MakeSureLinkIsUp $ftpI
  117.   set new_wd [FTP_TrimDir $new_wd]
  118.   set ftp($ftpI,new_wd) $new_wd
  119.   set ftp($ftpI,state) isdir
  120.   return [FTP_CtlAutomata $ftpI]
  121. }
  122.  
  123. proc FTP_PWD { ftpI } {
  124.   global ftp
  125.   FTP_MakeSureLinkIsUp $ftpI
  126.   set ftp($ftpI,state) dopwd
  127.   return [FTP_CtlAutomata $ftpI]
  128. }
  129.  
  130. proc FTP_CloseSession { ftpI } {
  131.   global ftp
  132.  
  133. # Just shut down the sockets
  134.   FTP_ShutDown $ftpI
  135.   return
  136.  
  137. # This is slow...
  138.   FTP_MakeSureLinkIsUp $ftpI
  139.   set ftp($ftpI,state) closing
  140.   FTP_CtlAutomata $ftpI
  141. }
  142.  
  143. proc FTP_List { ftpI showall } {
  144.   global ftp
  145.   FTP_MakeSureLinkIsUp $ftpI
  146.   LogStatusOnly "Reading ftp directory $ftp($ftpI,realhost)$ftp($ftpI,pwd)"
  147.   set cache_result [FTP_ReadCache $ftp($ftpI,realhost)$ftp($ftpI,pwd)]
  148.   if {$cache_result != ""} {
  149.     LogStatusOnly "Reading ftp directory $ftp($ftpI,realhost)$ftp($ftpI,pwd) -- done (found in cache)"
  150.     return $cache_result
  151.   }
  152.   set ftp($ftpI,state) listing
  153.   set ftp($ftpI,fileshow,all) $showall
  154.   set result [FTP_CtlAutomata $ftpI]
  155.   FTP_WriteCache $ftp($ftpI,realhost)$ftp($ftpI,pwd) $result
  156.   LogStatusOnly "Reading ftp directory $ftp($ftpI,realhost)$ftp($ftpI,pwd) -- done"
  157.   return $result
  158. }
  159.  
  160. proc FTP_DoSearch { ftpI filename } {
  161.   global ftp
  162.   FTP_MakeSureLinkIsUp $ftpI
  163.   set ftp($ftpI,state) search
  164.   set ftp($ftpI,search,name) $filename
  165.   return [FTP_CtlAutomata $ftpI]
  166. }
  167.  
  168. proc FTP_GetFile { ftpI remoteFileName localFileName expectedSize {resume 0}} {
  169.   global ftp
  170.   FTP_MakeSureLinkIsUp $ftpI
  171.   set ftp($ftpI,state) getfile
  172.  
  173.   if { [string range $remoteFileName 0 1] == "//" } {
  174.     set remoteFileName [string range $remoteFileName 1 end]
  175.   }
  176.   if { [string range $localFileName 0 1] == "//" } {
  177.     set localFileName [string range $localFileName 1 end]
  178.   }
  179.  
  180.   set ftp($ftpI,remote_fname) $remoteFileName
  181.   set ftp($ftpI,local_fname) $localFileName
  182.   set ftp($ftpI,expected_size) $expectedSize
  183.   set ftp($ftpI,resume) 0
  184.   if { $resume && [file writable "$localFileName"] } {
  185.     set r [catch {set ftp($ftpI,resume,pos) [file size "$localFileName"]}]
  186.     set ftp($ftpI,resume) [expr !$r]
  187.   }
  188.   return [FTP_CtlAutomata $ftpI]
  189. }
  190.  
  191. proc FTP_PutFile { ftpI localFileName remoteFileName expectedSize } {
  192.   global ftp
  193.  
  194.   #FTP_CD $ftpI [file dirname $remoteFileName]
  195.  
  196.   if { [string range $remoteFileName 0 1] == "//" } {
  197.     set remoteFileName [string range $remoteFileName 1 end]
  198.   }
  199.   if { [string range $localFileName 0 1] == "//" } {
  200.     set localFileName [string range $localFileName 1 end]
  201.   }
  202.  
  203.   FTP_MakeSureLinkIsUp $ftpI
  204.   set ftp($ftpI,state) putfile
  205.  
  206.   set ftp($ftpI,remote_fname) $remoteFileName
  207.   set ftp($ftpI,local_fname) $localFileName
  208.   set ftp($ftpI,expected_size) $expectedSize
  209.   FTP_InvalidateCache
  210.   return [FTP_CtlAutomata $ftpI]
  211. }
  212.  
  213. proc FTP_InvalidateCache {} {
  214.   global ftp
  215.   set ftp(cache) ""
  216. }
  217.  
  218.  
  219. # ----------- Helper functions
  220.  
  221. proc FTP_CtlAutomata { ftpI } {
  222.   global ftp
  223.  
  224.   set ret ""
  225.   while { 1 } {
  226.     if { $ftp($ftpI,debug) } {
  227.       puts "--$ftp($ftpI,state)"
  228.     }
  229.     switch $ftp($ftpI,state) {
  230.       initial {
  231.         # Initiating and logging in
  232.         # Open control connection to ftp server
  233.         set r [catch {FTP_Socket $ftp($ftpI,host) $ftp($ftpI,port)} tmp]
  234.         if { $r != 0 } {
  235.           FTP_Error $ftpI $tmp
  236.         }
  237.         set ftp($ftpI,ctl_fd) [lindex $tmp 0]
  238.         set ftp($ftpI,local_ip) [lindex $tmp 1]
  239.         #set ftp($ftpI,port_cmd) [FTP_SetupDatareceiver $ftpI] #Let's do this for every connection instead...
  240.         set ftp($ftpI,state) ctl_open
  241.       }
  242.       ctl_open {
  243.         if { $ctl_code0 == "2" } {
  244.           FTP_WriteControl $ftpI "USER $ftp($ftpI,user)"
  245.           set ftp($ftpI,state) user_sent
  246.         } else {
  247.           FTP_Error $ftpI "Error connecting"
  248.         }
  249.       }
  250.       user_sent {
  251.         if { $ctl_code0 == "2" } {
  252.           set ftp($ftpI,state) ready
  253.         } elseif { $ctl_code0 == "3" } {
  254.           FTP_WriteControl $ftpI "PASS $ftp($ftpI,password)"
  255.           set ftp($ftpI,state) password_sent
  256.         } else {
  257.           FTP_Error $ftpI "Error connecting"
  258.         }
  259.       }
  260.       password_sent {
  261.         if { $ctl_code0 == "2" } {
  262.           set ftp($ftpI,state) ready
  263.         } else {
  264.           FTP_Error $ftpI "Error connecting"
  265.         }
  266.       }
  267.       closing {
  268.         # closing down
  269.         FTP_WriteControl $ftpI "QUIT"
  270.         set ftp($ftpI,state) quit_sent
  271.       }
  272.       quit_sent {
  273.         FTP_ShutDown $ftpI
  274.         set ftp($ftpI,state) ready
  275.       }
  276.       listing {
  277.         # listing
  278.         if { $ftp($ftpI,type) != "A" } {
  279.           FTP_WriteControl $ftpI "TYPE A"
  280.           set ftp($ftpI,type)  A
  281.           set ftp($ftpI,state) listing_type_sent
  282.         } else {
  283.           FTP_WriteControl $ftpI [FTP_SetupDatareceiver $ftpI]
  284.           set ftp($ftpI,state) listing_port_sent
  285.         }
  286.       }
  287.       listing_type_sent {
  288.         if { $ctl_code0 == "2" } {
  289.           FTP_WriteControl $ftpI [FTP_SetupDatareceiver $ftpI]
  290.           set ftp($ftpI,state) listing_port_sent
  291.         } else {
  292.           FTP_Error $ftpI "Error changing to ascii mode"
  293.         }
  294.       }
  295.       listing_port_sent {
  296.         if { $ctl_code0 == "2" } {
  297.           if {$ftp($ftpI,fileshow,all)} {
  298.             FTP_WriteControl $ftpI "LIST -a"
  299.           } else {
  300.             FTP_WriteControl $ftpI "LIST"
  301.           }
  302.           set ftp($ftpI,state) listing_list_sent
  303.         } else {
  304.           FTP_Error $ftpI "Error setting receive port"
  305.         }
  306.       }
  307.       listing_list_sent {
  308.         if { $ctl_code0 == "1" } {
  309.           set ret [FTP_ReadDataAsList $ftpI]
  310.           if { $ftp($ftpI,debug) } {
  311.             puts "$ret"
  312.           }
  313.           set ftp($ftpI,state) listing_list_received
  314.         } else {
  315.           FTP_Error $ftpI "Error listing"
  316.         }
  317.       }
  318.       listing_list_received {
  319.         if { $ctl_code0 == "2" } {
  320.           set ftp($ftpI,state) ready
  321.         } else {
  322.           FTP_Error $ftpI "Error receiving list"
  323.         }
  324.       }
  325.       docd {
  326.         FTP_WriteControl $ftpI "CWD $ftp($ftpI,new_wd)"
  327.         set ftp($ftpI,state) docd_cd_sent
  328.       }
  329.       docd_cd_sent {
  330.         if { $ctl_code0 == "2" } {
  331.           set ftp($ftpI,pwd) $ftp($ftpI,new_wd)
  332.           set ftp($ftpI,state) ready
  333.         } elseif { $ctl_code == "421" } {
  334.           FTP_Error $ftpI "Error cd'ing to $ftp($ftpI,new_wd)"
  335.         } else {
  336.           FTP_Warn $ftpI "Error cd'ing to $ftp($ftpI,new_wd)"
  337.         }
  338.       }
  339.       dopwd {
  340.           FTP_WriteControl $ftpI "PWD"
  341.           set ftp($ftpI,state) dopwd_pwd_sent
  342.       }
  343.       dopwd_pwd_sent {
  344.         if { $ctl_code0 == "2" } {
  345.           set r [regexp {[0-9]+ "(.*)"} $ctl_mess match new_pwd]
  346.           if { !$r } { FTP_Error $ftpI "Error parsing current directory ($ctl_mess)" }
  347.           set ftp($ftpI,pwd) $new_pwd
  348.           set ftp($ftpI,state) ready
  349.           set ret $new_pwd
  350.         } else {
  351.           FTP_Error $ftpI "Error retreiving present working directory"
  352.         }
  353.       }
  354.       isdir {
  355.         FTP_WriteControl $ftpI "CWD $ftp($ftpI,new_wd)"
  356.         set ftp($ftpI,state) isdir_cd_sent
  357.       }
  358.       isdir_cd_sent {
  359.         if { $ctl_code0 == "2" } {
  360.           set ret 1
  361.         } else {
  362.           set ret 0
  363.         }
  364.         set ftp($ftpI,pwd) ""
  365.         set ftp($ftpI,state) ready
  366.       }
  367.       getfile {
  368.         # retreiving file
  369.         if { $ftp($ftpI,type) != "I" } {
  370.           FTP_WriteControl $ftpI "TYPE I"
  371.           set ftp($ftpI,type)  I
  372.           set ftp($ftpI,state) getfile_type_sent
  373.         } else {
  374.           FTP_WriteControl $ftpI [FTP_SetupDatareceiver $ftpI]
  375.           set ftp($ftpI,state) getfile_port_sent
  376.         }
  377.       }
  378.       getfile_type_sent {
  379.         if { $ctl_code0 == "2" } {
  380.           FTP_WriteControl $ftpI [FTP_SetupDatareceiver $ftpI]
  381.           set ftp($ftpI,state) getfile_port_sent
  382.         } else {
  383.           FTP_Error $ftpI "Error changing to binary mode"
  384.         }
  385.       }
  386.       getfile_port_sent {
  387.         if { $ctl_code0 == "2" } {
  388.           if { $ftp($ftpI,resume) } {
  389.             FTP_WriteControl $ftpI "REST $ftp($ftpI,resume,pos)"
  390.             set ftp($ftpI,state) getfile_rest_sent
  391.           } else {
  392.             FTP_WriteControl $ftpI "RETR $ftp($ftpI,remote_fname)"
  393.             set ftp($ftpI,state) getfile_retr_sent
  394.           }
  395.         } else {
  396.           FTP_Error $ftpI "Error setting receive port"
  397.         }
  398.       }
  399.       getfile_rest_sent {
  400.         if { $ctl_code0 == "3" } {
  401.           FTP_WriteControl $ftpI "RETR $ftp($ftpI,remote_fname)"
  402.           set ftp($ftpI,state) getfile_retr_sent
  403.         } else {
  404.           FTP_Warn $ftpI "Server does not support resume on FTP transfers."
  405.         }
  406.       }
  407.       getfile_retr_sent {
  408.         if { $ctl_code0 == "1" } {
  409.           if { $ftp($ftpI,resume) } {
  410.             set ret [FTP_TransferFile $ftpI w+]
  411.           } else {
  412.             set ret [FTP_TransferFile $ftpI w]
  413.           }
  414.           set ftp($ftpI,state) getfile_file_received
  415.         } else {
  416.           FTP_Error $ftpI "Error retrieving remote file $ftp($ftpI,remote_fname)"
  417.         }
  418.       }
  419.       getfile_file_received {
  420.         if { $ctl_code0 == "2" } {
  421.           set ftp($ftpI,state) ready
  422.         } else {
  423.           FTP_Error $ftpI "Error receiving remote file $ftp($ftpI,remote_fname)"
  424.         }
  425.       }
  426.       putfile {
  427.         # sending file
  428.         if { $ftp($ftpI,type) != "I" } {
  429.           FTP_WriteControl $ftpI "TYPE I"
  430.           set ftp($ftpI,type)  I
  431.           set ftp($ftpI,state) putfile_type_sent
  432.         } else {
  433.           FTP_WriteControl $ftpI [FTP_SetupDatareceiver $ftpI]
  434.           set ftp($ftpI,state) putfile_port_sent
  435.         }
  436.       }
  437.       putfile_type_sent {
  438.         if { $ctl_code0 == "2" } {
  439.           FTP_WriteControl $ftpI [FTP_SetupDatareceiver $ftpI]
  440.           set ftp($ftpI,state) putfile_port_sent
  441.         } else {
  442.           FTP_Error $ftpI "Error changing to binary mode"
  443.         }
  444.       }
  445.       putfile_port_sent {
  446.         if { $ctl_code0 == "2" } {
  447.           FTP_WriteControl $ftpI "STOR $ftp($ftpI,remote_fname)"
  448.           set ftp($ftpI,state) putfile_stor_sent
  449.         } else {
  450.           FTP_Error $ftpI "Error setting port"
  451.         }
  452.       }
  453.       putfile_stor_sent {
  454.         if { $ctl_code0 == "1" } {
  455.           set ret [FTP_TransferFile $ftpI r]
  456.           set ftp($ftpI,state) putfile_file_sent
  457.         } else {
  458.           FTP_Error $ftpI "Error storing file $ftp($ftpI,remote_fname)"
  459.         }
  460.       }
  461.       putfile_file_sent {
  462.         if { $ctl_code0 == "2" } {
  463.           set ftp($ftpI,state) ready
  464.         } else {
  465.           FTP_Error $ftpI "Error storing file $ftp($ftpI,remote_fname)"
  466.         }
  467.       }
  468.       rename {
  469.         FTP_WriteControl $ftpI "RNFR $ftp($ftpI,rename,oldname)"
  470.         set ftp($ftpI,state) rename_rnfr_sent
  471.       }
  472.       rename_rnfr_sent {
  473.         if { $ctl_code0 == "3" } {
  474.           FTP_WriteControl $ftpI "RNTO $ftp($ftpI,rename,newname)"
  475.           set ftp($ftpI,state) rename_rnto_sent
  476.         } else {
  477.           FTP_Warn $ftpI "Error renaming file $ftp($ftpI,rename,oldname) to $ftp($ftpI,rename,newname)"
  478.         }
  479.       }
  480.       rename_rnto_sent {
  481.         if { $ctl_code0 == "2" } {
  482.           set ftp($ftpI,state) ready
  483.         } else {
  484.           FTP_Warn $ftpI "Error renaming file $ftp($ftpI,rename,oldname) to $ftp($ftpI,rename,newname)"
  485.         }
  486.       }
  487.       delete {
  488.         FTP_WriteControl $ftpI "DELE $ftp($ftpI,delete,filename)"
  489.         set ftp($ftpI,state) delete_dele_sent
  490.       }
  491.       delete_dele_sent {
  492.         if { $ctl_code0 == "2" } {
  493.           set ftp($ftpI,state) ready
  494.         } else {
  495.           FTP_Warn $ftpI "Error deleting file $ftp($ftpI,delete,filename)"
  496.         }
  497.       }
  498.       mkdir {
  499.         FTP_WriteControl $ftpI "MKD $ftp($ftpI,mkdir,dir)"
  500.         set ftp($ftpI,state) mkdir_mkd_sent
  501.       }
  502.       mkdir_mkd_sent {
  503.         if { $ctl_code0 == "2" } {
  504.           set ftp($ftpI,state) ready
  505.         } else {
  506.           FTP_Warn $ftpI "Error creating dir $ftp($ftpI,mkdir,dir)"
  507.         }
  508.       }
  509.       rmdir {
  510.         FTP_WriteControl $ftpI "RMD $ftp($ftpI,rmdir,dir)"
  511.         set ftp($ftpI,state) rmdir_rmd_sent
  512.       }
  513.       rmdir_rmd_sent {
  514.         if { $ctl_code0 == "2" } {
  515.           set ftp($ftpI,state) ready
  516.         } else {
  517.           FTP_Warn $ftpI "Error deleting dir $ftp($ftpI,rmdir,dir) (not empty?)"
  518.         }
  519.       }
  520.       search {
  521.         FTP_WriteControl $ftpI "SITE EXEC LOCATE $ftp($ftpI,search,name)"
  522.         set ftp($ftpI,state) search_locate_sent
  523.       }
  524.       search_locate_sent {
  525.         if { $ctl_code0 == "2" } {
  526.           set ret $ftp($ftpI,ctl_mess)
  527.           set ftp($ftpI,state) ready
  528.         } else {
  529.           FTP_Warn $ftpI "Error searching for $ftp($ftpI,search,name)"
  530.         }
  531.       }
  532.       default {
  533.         FTP_Error $ftpI "Unhandled state in ftp automata"
  534.       }
  535.     }
  536.     if { $ftp($ftpI,state) == "ready" } {
  537.       if { $ftp($ftpI,debug) } {
  538.         puts "++ready"
  539.       }
  540.       break
  541.     }
  542.     FTP_ReadControl $ftpI ctl_mess ctl_code ctl_code0 ctl_code1 ctl_code2
  543.     set ftp($ftpI,ctl_mess) $ctl_mess
  544.     if {$ctl_mess == ""} {
  545.       FTP_Error $ftpI "Error reading ftp control socket"
  546.     }
  547.   }
  548.   return $ret
  549. }
  550.  
  551. proc FTP_Error { ftpI message } {
  552.   global ftp
  553.   set m "$message\n\nHost: $ftp($ftpI,realhost)\nState: $ftp($ftpI,state)\n\Command: $ftp($ftpI,ctl_cmd)\nMessage: $ftp($ftpI,ctl_mess)"
  554.   FTP_ShutDown $ftpI
  555.   error "$m"
  556. }
  557.  
  558. proc FTP_Warn { ftpI message } {
  559.   global ftp
  560.   set m "$message\n\nHost: $ftp($ftpI,realhost)\nState: $ftp($ftpI,state)\n\Command: $ftp($ftpI,ctl_cmd)\nMessage: $ftp($ftpI,ctl_mess)"
  561.   set ftp($ftpI,state) ready
  562.   error "$m"
  563. }
  564.  
  565. proc FTP_WarnLite { ftpI message } {
  566.   global ftp
  567.   set m "$message\n\nHost: $ftp($ftpI,realhost)\nState: $ftp($ftpI,state)\n\Command: $ftp($ftpI,ctl_cmd)\nMessage: $ftp($ftpI,ctl_mess)"
  568.   #set ftp($ftpI,state) ready
  569.   PopWarn "$m"
  570. }
  571.  
  572. proc FTP_ReadControl { ftpI var_ctl_mess var_ctl_code var_ctl_code0 var_ctl_code1 var_ctl_code2 } {
  573.   global ftp config
  574.  
  575.   upvar $var_ctl_mess ctl_mess
  576.   upvar $var_ctl_code ctl_code
  577.   upvar $var_ctl_code0 ctl_code0
  578.   upvar $var_ctl_code1 ctl_code1
  579.   upvar $var_ctl_code2 ctl_code2
  580.  
  581.   set ctl_mess ""
  582.   set code 0
  583.  
  584.   while { 1 } {
  585.     set r [catch {FTP_ReadText $ftp($ftpI,ctl_fd) $config(ftp,timeout)} line]
  586.     if {$r} {FTP_Error $ftpI $line}
  587.     set count [string length $line]
  588.     if { $count == 0 } { 
  589.       set ctl_mess ""
  590.       break
  591.     } else {
  592.       set incode [string range $line 0 2]
  593.       set contcode [string index $line 3]
  594.       append ctl_mess $line
  595.       if { $code == 0 } {
  596.         if { $contcode == "-" } {
  597.           set code $incode
  598.         } else {
  599.           set code $incode
  600.           break
  601.         }
  602.       } else {
  603.         if { $incode == $code && $contcode == " " } {
  604.           break
  605.         }
  606.       }
  607.     }
  608.   }
  609.   set ctl_code $code
  610.   set ctl_code0 [string index $code 0]
  611.   set ctl_code1 [string index $code 1]
  612.   set ctl_code2 [string index $code 2]
  613.   if { $ftp($ftpI,debug) } {
  614.     puts "$ctl_mess"
  615.   }
  616. }
  617.  
  618.  
  619. proc FTP_ShutDown { ftpI } {
  620.   global ftp
  621.   if { $ftp($ftpI,server_fd) != 0 } {
  622.     catch { FTP_Close $ftp($ftpI,server_fd) } out
  623.     set ftp($ftpI,server_fd) 0
  624.   }
  625.   if { $ftp($ftpI,ctl_fd) != 0 } {
  626.     catch { FTP_Close $ftp($ftpI,ctl_fd) } out
  627.     set ftp($ftpI,ctl_fd) 0
  628.   }
  629. #  set ftp($ftpI,host) ""
  630. #  set ftp($ftpI,realhost) ""
  631. #  set ftp($ftpI,user) ""
  632. #  set ftp($ftpI,password) ""
  633.   set ftp($ftpI,state) initial
  634.   set ftp($ftpI,type) unknown
  635.   set ftp($ftpI,ctl_fd) 0
  636.   set ftp($ftpI,server_fd) 0
  637. #  set ftp($ftpI,debug) 0
  638.   set ftp($ftpI,local_ip) ""
  639.   set ftp($ftpI,pwd) ""
  640.   set ftp($ftpI,new_wd) ""
  641.   set ftp($ftpI,ctl_mess) ""
  642.   set ftp($ftpI,ctl_cmd) ""
  643.   set ftp($ftpI,resume) 0
  644. }
  645.  
  646. proc FTP_WriteControl { ftpI output } {
  647.   global ftp
  648.   set ftp($ftpI,ctl_cmd) "$output"
  649.   set r [catch {FTP_WriteText $ftp($ftpI,ctl_fd) "$output\r\n"} out]
  650.   if {$r} {FTP_Error $ftpI $out}
  651.   if { $ftp($ftpI,debug) } {
  652.     puts ">> $output"
  653.   }
  654. }
  655.  
  656. proc FTP_ConvPortToNums { portnum } {
  657.   return [expr ($portnum & 0xff00) >> 8],[expr $portnum & 0xff]
  658. }
  659.  
  660. proc FTP_SetupDatareceiver { ftpI } {
  661.   global ftp
  662.   if { $ftp($ftpI,server_fd) != 0 } {
  663.     catch { FTP_Close $ftp($ftpI,server_fd) } out
  664.     set ftp($ftpI,server_fd) 0
  665.   }
  666.   set r [catch {FTP_CreateServerSocket $ftp($ftpI,local_ip)} t]
  667.   if {$r} {FTP_Error $ftpI $t}
  668.   regexp {([0-9]+)\.([0-9]+)\.([0-9]+)\.([0-9]+),([0-9]+) (.+)} $t match a1 a2 a3 a4 p ftp($ftpI,server_fd)
  669.   return "PORT $a1,$a2,$a3,$a4,[FTP_ConvPortToNums $p]"
  670. }
  671.  
  672. # separate input lines to list elements 
  673. proc FTP_ReadDataAsList { ftpI } {
  674.   global ftp config
  675.   set r [catch {FTP_AcceptConnect $ftp($ftpI,server_fd)} datafd]
  676.   if {$r} {FTP_Error $ftpI $datafd}
  677.   set list {}
  678.   while { 1 } {
  679.     set r [catch {FTP_ReadText $datafd $config(ftp,timeout)} line]
  680.     if {$r} {
  681.       FTP_Close $datafd
  682.       FTP_Error $ftpI $line
  683.     }
  684.     lappend list "$line"
  685.     if {$line == ""} {
  686.       FTP_Close $datafd
  687.       return $list
  688.     }
  689.   }
  690. }
  691.  
  692.  
  693. proc FTP_TransferFile { ftpI mode } {
  694.   global ftp config glob
  695.   set oldiconname [wm iconname .]
  696.   set chunk 1
  697.   set chunksize 4096
  698.   set goal_upd_length 2000
  699.   # That's 2000 milliseconds, by the way... (I hate myself for not commenting more...:-)
  700.   set r [catch {FTP_OpenFile $ftp($ftpI,local_fname) $mode} fd1]
  701.   if {$r} {FTP_Error $ftpI "$ftp($ftpI,local_fname): $fd1"}
  702.   set r [catch {FTP_AcceptConnect $ftp($ftpI,server_fd)} fd2]
  703.   if {$r} {FTP_Error $ftpI $fd2}
  704.  
  705.   if {$mode == "r"} {
  706.     set from_fd $fd1
  707.     set to_fd $fd2
  708.   } else {
  709.     set from_fd $fd2
  710.     set to_fd $fd1
  711.   }
  712.  
  713.   #fconfigure $from_fd -translation binary
  714.   #fconfigure $to_fd -translation binary
  715.  
  716.   set size 0
  717.   if {$ftp($ftpI,resume)} {
  718.     set size $ftp($ftpI,resume,pos)
  719.   }
  720.   set start_time [clock seconds]
  721.   set tl {}
  722.   for {set i 0} {$i < 30} {incr i} {
  723.     lappend tl {0 -1}
  724.   }
  725.  
  726.   set t_one [ClockMilliSeconds]
  727.   while { 1 } {
  728.     set timesum 0.0
  729.     set bytesum 0
  730.     set timenum 0
  731.     foreach tli $tl {
  732.       if { [lindex $tli 1] != -1 } {
  733.         set timesum [expr $timesum + [lindex $tli 0]]
  734.         incr bytesum [lindex $tli 1]
  735.         incr timenum
  736.       }
  737.     }
  738.     if { $timesum <= 0.0 } { set timesum 1 }
  739.     set speed [format "%.2f" [expr ($bytesum / ($timesum / 1000.0)) / 1024.0]]
  740.     set speed_Bps [expr ($bytesum / ($timesum / 1000.0))]
  741.     set eta "?"
  742.     set eta_abs "?"
  743.     if {$speed_Bps > 0} {
  744.       set tmp [format "%.0f" [expr ($ftp($ftpI,expected_size) - $size) / $speed_Bps]]
  745.       if { $tmp >= 0 } { 
  746.         set eta [format "%02d:%02d" [expr $tmp / 60] [expr $tmp % 60]] 
  747.         if { $config(dateformat) == "yymmdd" } {
  748.           set tmp_date "%y%m%d "
  749.         } else {
  750.           set tmp_date "%y%m%d "
  751.         } 
  752.         set tmp_s [clock seconds]
  753.         if { [clock format [expr $tmp_s + $tmp] -format "%y%m%d"] == [clock format $tmp_s -format "%y%m%d"] } {
  754.           set tmp_date ""
  755.         }
  756.         set eta_abs [clock format [expr $tmp_s + $tmp] -format "$tmp_date%R"]
  757.       }
  758.     }
  759.     if {$ftp($ftpI,expected_size) > 0} {
  760.       LogStatusOnly "Transfer [file tail $ftp($ftpI,remote_fname)] : $size / $ftp($ftpI,expected_size) bytes ($speed kB/s, ETA $eta $eta_abs)"
  761.     } else {
  762.       LogStatusOnly "Transfer [file tail $ftp($ftpI,remote_fname)] : $size bytes ($speed kB/s)"
  763.     }
  764.     wm iconname . "$eta $eta_abs [file tail $ftp($ftpI,remote_fname)]"
  765.     update
  766.     if { $glob(abortcmd) } {
  767.       wm iconname . "$oldiconname"
  768.       FTP_Close $from_fd
  769.       FTP_Close $to_fd
  770.       FTP_Error $ftpI "FTP transfer aborted, link closed."
  771.     }
  772.     set r [catch {FTP_Copy $from_fd $to_fd [expr $chunk * $chunksize] $config(ftp,timeout)} i]
  773.     set t_two [ClockMilliSeconds]
  774.     set t [expr $t_two - $t_one]
  775.     if {$t < 0} {
  776.       set t 0
  777.     }
  778.     set t_one $t_two
  779.     if {$r} {  
  780.       wm iconname . "$oldiconname"
  781.       FTP_Close $from_fd
  782.       FTP_Close $to_fd
  783.       FTP_Error $ftpI $i
  784.     }
  785.     if {$i == 0} break
  786.     lappend tl "$t [expr $chunk * $chunksize]"
  787.     set tl [lrange $tl 1 end]
  788.     incr size $i
  789.     set oldchunk $chunk
  790.     if {$t == 0} {
  791.       set chunk [expr 2 * $oldchunk]
  792.     } else {
  793.       set chunk [expr int(($oldchunk * $goal_upd_length) / $t)]
  794.     }
  795.     if {$chunk > [expr 2 * $oldchunk]} {set chunk [expr 2 * $oldchunk]}
  796.     if {$chunk < [expr $oldchunk / 2]} {set chunk [expr $oldchunk / 2]}
  797.     if {$chunk > 900} {set chunk 900}
  798.     if {$chunk < 1} {set chunk 1}
  799.   }
  800.   FTP_Close $from_fd
  801.   FTP_Close $to_fd
  802.   set end_time [clock seconds]
  803.   if {$end_time == $start_time} {
  804.     set total_speed "? kB/s"
  805.   } else {
  806.     if {$ftp($ftpI,resume)} {
  807.       set total_speed "[format "%.2f" [expr ($size - $ftp($ftpI,resume,pos)) / 1024.0 / ($end_time - $start_time)]] kB/s"
  808.     } else {
  809.       set total_speed "[format "%.2f" [expr $size / 1024.0 / ($end_time - $start_time)]] kB/s"
  810.     }
  811.   }
  812.   wm iconname . "$oldiconname"
  813.   LogStatusOnly "Transfer [file tail $ftp($ftpI,remote_fname)] : $size bytes -- done ($total_speed)"
  814.   if {$mode == "w" } {
  815.     LogSilent "Transfer ftp://$ftp($ftpI,realhost)$ftp($ftpI,remote_fname) -> $ftp($ftpI,local_fname): $size bytes -- done ($total_speed)"
  816.   } else {
  817.     LogSilent "Transfer $ftp($ftpI,local_fname) -> ftp://$ftp($ftpI,realhost)$ftp($ftpI,remote_fname): $size bytes -- done ($total_speed)"
  818.   }
  819.  
  820.   if { $mode != "r" && [Try { set s [file size $ftp($ftpI,local_fname)] } "" 1] == 0 } {
  821.     if { $ftp($ftpI,expected_size) > 0 && ($s != $ftp($ftpI,expected_size) || $s != $size) } {
  822.       PopWarn "Warning: Files ftp://$ftp($ftpI,realhost)$ftp($ftpI,remote_fname), $ftp($ftpI,local_fname) are not the same size"
  823.     }
  824.   }
  825.   return $size
  826. }
  827.  
  828. proc FTP_ReadCache { key } {
  829.   global ftp
  830.   set i 0
  831.   foreach k $ftp(cache) {
  832.     if {[lindex $k 0] == "$key"} {
  833.       set item $k
  834.       set result [lindex $item 1]
  835.       set ftp(cache) [concat [lrange $ftp(cache) 0 [expr $i - 1]] [lrange $ftp(cache) [expr $i + 1] end]]
  836.       lappend ftp(cache) $item
  837.       return [lindex $item 1]
  838.     }
  839.     incr i
  840.   }
  841.   return ""
  842. }
  843.  
  844. proc FTP_WriteCache { key data } {
  845.   global ftp config
  846.   set item [list $key $data]
  847.   lappend ftp(cache) $item
  848.   set length [llength $ftp(cache)]
  849.   if {$length > $config(ftp,cache,maxentries)} {
  850.     set ftp(cache) [lrange $ftp(cache) 1 end]
  851.   }
  852. }
  853.  
  854.